home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / Marlais 0.5.9-portable sources / dylan.y < prev    next >
Encoding:
Lex Description  |  1995-03-15  |  34.0 KB  |  1,482 lines  |  [TEXT/ttxt]
  1. %{ /* Emacs: -*- Fundamental -*- */
  2.  
  3. /*
  4.    This software is free software; you can redistribute it and/or
  5.    modify it under the terms of the GNU Library General Public
  6.    License as published by the Free Software Foundation; either
  7.    version 2 of the License, or (at your option) any later version.
  8.  
  9.    This software is distributed in the hope that it will be useful,
  10.    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12.    Library General Public License for more details.
  13.  
  14.    You should have received a copy of the GNU Library General Public
  15.    License along with this software; if not, write to the Free
  16.    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17.  
  18.    Original authorship and copyright notices follows
  19.  
  20.  */
  21.  
  22. /* interim-dylan.y -- dylan phrase grammar from 5/12/94 interim report */
  23.  
  24. /*
  25.  * this grammar is, i believe, an accurate translation of the
  26.  * BNF grammar in the appendix to the 5/12/94 interim report
  27.  * into yacc-friendly format.  the differences are
  28.  *
  29.  *    + where the BNF used ellipses to indicate repitition,
  30.  *      (right) recursive productions have been added.
  31.  *
  32.  *    + the grammar has been rearranged to eliminate ambiguities
  33.  *      (what yacc calls conflicts);  this grammar should have
  34.  *      no shift/reduce or reduce/reduce conflicts.  occasional
  35.  *      comments explain what had to be done in the dicier of
  36.  *      situations.
  37.  *
  38.  *    + according to notes from the partners' mailing list, a
  39.  *      few productions were omitted from the grammar in the
  40.  *      report;  these are flagged with the comment "omitted"
  41.  *      in this grammar.
  42.  *
  43.  * paul haahr
  44.  * 22 may 1994
  45.  */
  46.  
  47. /*
  48.    Marlais Revisions Copyright 1994, Joseph N. Wilson.  All Rights Reserved.
  49.  
  50.    Permission to use, copy, and modify this software and its
  51.    documentation is hereby granted only under the following terms and
  52.    conditions.  Both the above copyright notice and this permission
  53.    notice must appear in all copies of the software, derivative works
  54.    or modified version, and both notices must appear in supporting
  55.    documentation.  Users of this software agree to the terms and
  56.    conditions set forth in this notice.
  57. */
  58.  
  59. /* 
  60.  * Modified this to have built-in rules for control constructs.
  61.  * I'll save macro implementation for a little later.
  62.  * 
  63.  * jnw@cis.ufl.edu
  64.  * 15 July 1994
  65.  */
  66.  
  67. #ifdef MACOS
  68. #define YYDEBUG 0
  69. #endif
  70.  
  71. /* #define OPTIMIZE_SPECIALIZERS */
  72.  
  73. #include "boolean.h"
  74. #include "bytestring.h"
  75. #include "error.h"
  76. #include "gc.h"
  77. #include "globaldefs.h"
  78. #include "list.h"
  79. #include "number.h"
  80. #include "object.h"
  81. #include "symbol.h"
  82. #include "table.h"
  83. #include "vector.h"
  84. #include "yystype.h"
  85.  
  86. #define alloca GC_malloc
  87.  
  88. void yyerror (char *);
  89. static Object append_bang (Object l1, Object l2);
  90.  
  91. extern char *yytext;
  92. extern Object *parse_value_ptr;
  93.  
  94. extern int yylineno;
  95.  
  96. void push_intermediate_words (Object begin_word);
  97. void pop_intermediate_words (void);
  98.  
  99. Object binding_stack;
  100. Object symtab;
  101. Object methnames, methdefs;
  102. static void push_bindings();
  103. static void pop_bindings();
  104. static Object bindings_top ();
  105. static Object bindings_increment ();
  106. static Object gensym(int i);
  107. static Object make_setter_expr (Object place, Object value);
  108. static int allocation_word (Object word);
  109. %}
  110.  
  111. /*
  112.  * Inappropriate start symbol for an interpreter
  113.  *
  114.     %start dylan_program
  115.  */
  116.  
  117. %start evaluable_constituent
  118.  
  119. %token    SYMBOL                /* identifier */
  120. %token    KEYWORD                /* identifier: */
  121. %token    LITERAL                /* #"..." */
  122. %token    STRING                /* "..." */
  123.  
  124. %token    '(' ')' '[' ']' '{' '}'
  125.  
  126. %right    COLON_EQUAL    /* := */
  127. %left    '&' '|'
  128. %left    GREATER_EQUAL LESSER_EQUAL '>' '<' NOT_EQUAL EQUAL_EQUAL '='
  129. %left    '-' '+'
  130. %left    '/' '*'
  131. %left    '^'
  132.  
  133. %token    '.' ',' ';' '~'
  134.  
  135. %token    EQUAL_ARROW    /* => */
  136. %token    COLON_COLON    /* :: */
  137.  
  138. /* For macros */
  139. %token    QUESTION_QUESTION    /* ?? */
  140. %token    ELLIPSIS        /* ... */
  141.  
  142. /* for signalling errors from lexical analyzer */
  143. %token UNRECOGNIZED
  144. %token EOF_TOKEN
  145.  
  146. %token    HASH_T HASH_F HASH_BRACKET HASH_PAREN
  147. %token    HASH_NEXT HASH_REST HASH_KEY HASH_ALL_KEYS
  148.  
  149. %token    DEFINE END GENERIC HANDLER LET LOCAL METHOD OTHERWISE
  150.  
  151. /*
  152.  * Wait for macros to include this general approach
  153.  * %token BLOCK_BEGIN_WORD EXPR_BEGIN_WORD SIMPLE_BEGIN_WORD
  154.  * %token INTERMEDIATE_WORD EXPR_INTERMEDIATE_WORD SIMPLE_INTERMEDIATE_WORD
  155.  */    
  156.  
  157. /*   %token    DEFINING_WORD */
  158. %token CLASS CONSTANT LIBRARY MODULE VARIABLE TEST
  159.  
  160. /* CLASS intermediate words */
  161. %token SLOT
  162. %token BEGIN_TOKEN CASE IF UNLESS UNTIL WHILE BLOCK FOR SELECT
  163.  
  164. /* MODULE intermediate words */
  165. %token USE EXPORT CREATE
  166.  
  167. /* IF intermediate words */
  168. %token ELSE ELSEIF
  169.  
  170. /* SELECT intermediate words */
  171. %token BY
  172.  
  173. /* FOR intermediate words */
  174. %token FINALLY
  175. %token THEN IN FROM TO ABOVE BELOW BY
  176.  
  177. /* BLOCK intermediate words */
  178. %token CLEANUP EXCEPTION
  179. %%
  180.  
  181.  
  182.  
  183. defining_word
  184.     : CLASS
  185.     | CONSTANT
  186.     | LIBRARY
  187.     | MODULE
  188.     | VARIABLE
  189.     | TEST
  190.  
  191. /* Program Structure */
  192.  
  193. /*
  194. dylan_program
  195.     : body
  196. */
  197.  
  198. evaluable_constituent
  199.     : ';'    { *parse_value_ptr = unspecified_object; YYACCEPT; }
  200.  
  201.     | defining_form    ';'
  202.         { *parse_value_ptr = $1; YYACCEPT; }
  203.  
  204.     | expression ';'
  205.         { *parse_value_ptr = $1; YYACCEPT; }
  206.  
  207.     | local_declaration
  208.         { *parse_value_ptr = unspecified_object;
  209.           warning("local binding outside of block ignored", NULL);
  210.           YYACCEPT;
  211.             }
  212.  
  213. /*    | constituent ';'
  214.         { *parse_value_ptr = $1; YYACCEPT; }
  215. */
  216.  
  217.     | EOF_TOKEN    { *parse_value_ptr = eof_object; YYACCEPT; }
  218.  
  219.     | error ';'
  220.         { yyerrok;
  221.           *parse_value_ptr = unspecified_object;
  222.           YYACCEPT;
  223.         }
  224.     | error EOF_TOKEN
  225.         { yyerrok;
  226.           *parse_value_ptr = eof_object;
  227.           YYACCEPT;
  228.         }
  229.  
  230. body
  231.     :        { $$ = unspecified_object; }
  232.     | nonempty_body    { $$ = $1; }
  233.  
  234. nonempty_body
  235.     :     { push_bindings (); }
  236.  
  237.       nonempty_constituents
  238.  
  239.       {
  240.        if (INTVAL (bindings_top ()) > 0) {
  241.            $$ = cons(unbinding_begin_symbol,
  242.              cons (bindings_top(), $2));
  243.        } else if (list_length ($2) > 1) {
  244.            $$ = cons (begin_symbol, $2);
  245.        } else {
  246.            $$ = FIRST ($2);
  247.        }
  248.        pop_bindings ();
  249.     }
  250.  
  251.  
  252. nonempty_constituents
  253.     : constituent            { $$ = cons ($1, make_empty_list()); }
  254.     | constituent ';' constituents    { $$ = cons ($1, $3); }
  255.  
  256. constituents
  257.     :                 { $$ = make_empty_list(); }
  258.     | constituent             { $$ = cons ($1, make_empty_list()); }
  259.     | constituent ';' constituents    { $$ = cons ($1, $3); }
  260. /*
  261.     | local_declaration_block    { $$ = cons ($1, make_empty_list()); }
  262. */
  263.  
  264.  
  265. constituent
  266.     : defining_form        { $$ = $1; }
  267.     | local_declaration    { $$ = $1; } 
  268.     | expression        { $$ = $1; }
  269. /*
  270.     | error    ';'        { yyerrok; $$ = unspecified_object; }
  271.  */
  272.  
  273. /* Expressions */
  274.  
  275. expression
  276.     : binary_operand    { $$ = $1; }
  277. /*    | unparenthesized_operand COLON_EQUAL expression */
  278.     | expression COLON_EQUAL expression
  279.            { if (SYMBOLP ( $1)) {
  280.          $$ = listem (set_bang_symbol, $1, $3, NULL);
  281.          } else {
  282.          $$ = make_setter_expr ($1, $3);
  283.          }
  284.        }
  285.     | expression '&' expression
  286.         { $$ = listem ($2, $1, $3, NULL); }
  287.     | expression '|' expression
  288.         { $$ = listem ($2, $1, $3, NULL); }
  289.     | expression GREATER_EQUAL expression
  290.         { $$ = listem ($2, $1, $3, NULL); }
  291.     | expression LESSER_EQUAL expression
  292.         { $$ = listem ($2, $1, $3, NULL); }
  293.     | expression '<' expression
  294.         { $$ = listem ($2, $1, $3, NULL); }
  295.     | expression '>' expression
  296.         { $$ = listem ($2, $1, $3, NULL); }
  297.     | expression NOT_EQUAL expression
  298.         { $$ = listem ($2, $1, $3, NULL); }
  299.     | expression EQUAL_EQUAL expression
  300.         { $$ = listem ($2, $1, $3, NULL); }
  301.     | expression '=' expression
  302.         { $$ = listem ($2, $1, $3, NULL); }
  303.     | expression '-' expression
  304.         { $$ = listem ($2, $1, $3, NULL); }
  305.     | expression '+' expression
  306.         { $$ = listem ($2, $1, $3, NULL); }
  307.     | expression '/' expression
  308.         { $$ = listem ($2, $1, $3, NULL); }
  309.     | expression '*' expression
  310.         { $$ = listem ($2, $1, $3, NULL); }
  311.     | expression '^' expression
  312.         { $$ = listem ($2, $1, $3, NULL); }
  313. /*
  314.     | error { yyerrok; }
  315. */
  316.  
  317.  
  318. binary_operand
  319.     : KEYWORD            { $$ = $1; }
  320.     | keyless_binary_operand    { $$ = $1; }
  321.  
  322. keyless_binary_operand
  323.     : operand            { $$ = $1; }
  324.     | unary_operator operand
  325.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  326.  
  327. unary_operator
  328.     : '-'                { $$ = negative_symbol; }
  329.     | '~'                { $$ = $1; }
  330.  
  331. operand    : operand '(' arguments_opt ')'
  332.  
  333.       {   
  334. #ifdef OPTIMIZE_SPECIALIZERS
  335.           $$ = cons ($1, $3);
  336. #else
  337.           $$ = cons ($1, $3);
  338. #endif
  339.       }
  340.     | operand '[' arguments ']'    /* array ref!!! */
  341.             { $$ = cons (element_symbol, cons ($1, $3)); }
  342.     | operand '.' variable_name
  343.         { $$ = cons ($3, cons ($1, make_empty_list())); }
  344.     | leaf                { $$ = $1; }
  345.  
  346. unparenthesized_operand
  347.     : unparenthesized_operand '(' arguments_opt ')'
  348.         {   
  349. #ifdef OPTIMIZE_SPECIALIZERS
  350.             $$ = cons ($1, $3);
  351. #else
  352.             $$ = cons ($1, $3);
  353. #endif
  354.         }
  355.     | unparenthesized_operand '[' arguments ']'
  356.             { $$ = cons (element_symbol, cons ($1, $3)); }
  357.     | unparenthesized_operand '.' variable_name
  358.         { $$ = cons ($3, cons ($1, make_empty_list())); }
  359.     | unparenthesized_leaf        { $$ = $1; }
  360.  
  361. arguments
  362.     : KEYWORD expression        { $$ = listem ($1, $2, NULL); }
  363.     | expression        { $$ = cons ($1, make_empty_list()); }
  364.     | KEYWORD expression ',' arguments
  365.         { $$ = cons ($1, cons ($2, $4)); }
  366.     | expression ',' arguments
  367.         { $$ = cons ($1, $3); }
  368.  
  369. leaf    : '(' expression ')'        { $$ = $2; }
  370.     | unparenthesized_leaf        { $$ = $1; }
  371.  
  372. unparenthesized_leaf
  373.     : literal            { $$ = $1; }
  374.     | variable_name            { $$ = $1; }
  375.     | METHOD method_body END METHOD_opt
  376.         { $$ = cons ($1, $2); }
  377.     | statement            { $$ = $1; }
  378.  
  379. literal    : LITERAL                { $$ = $1; }
  380.     | strings                { $$ = $1; }
  381.     | HASH_T                { $$ = $1; }
  382.     | HASH_F                { $$ = $1; }
  383.     | HASH_PAREN list_constants_opt ')'
  384.         { $$ = $2; }
  385.     | HASH_BRACKET constants_opt ']'
  386.         { $$ = make_sov ($2); }
  387.  
  388. strings    : STRING        { $$ = $1; }
  389.     | STRING component_strings    
  390.         { $$ = cons (concatenate_symbol, cons ($1, $2)); }
  391.  
  392. component_strings
  393.     : STRING    { $$ = cons ($1, make_empty_list()); }
  394.     | STRING component_strings
  395.         { $$ = cons ($1, $2); }
  396. constants
  397.     : constant            { $$ = cons ($1, make_empty_list()); }
  398.     | constant ',' constants    { $$ = cons ($1, $3); }
  399.  
  400. list_constants
  401.     : constant            { $$ = listem (pair_symbol,
  402.                                $1,
  403.                                make_empty_list(),
  404.                                NULL);
  405.                     }
  406.     | constant '.' constant        { $$ = listem (pair_symbol, $1, $3, NULL);
  407.                     }
  408.     | constant ',' list_constants    { $$ = listem (pair_symbol, $1, $3, NULL);
  409.                     }
  410.  
  411. constant
  412.     : literal            { $$ = $1; }
  413.     | KEYWORD            { $$ = $1; }
  414.  
  415.  
  416. /* Statements */
  417.  
  418. statement
  419.     : begin_statement    { $$ = $1; }
  420.     | if_statement        { $$ = $1; }
  421.     | unless_statement    { $$ = $1; }
  422.     | case_statement    { $$ = $1; }
  423.     | select_statement    { $$ = $1; }
  424.     | while_statement    { $$ = $1; }
  425.     | until_statement    { $$ = $1; }
  426.     | for_statement        { $$ = $1; }
  427.     | block_statement    { $$ = $1; }
  428. /*
  429.     | error END        { yyerrok; }
  430. */
  431.  
  432.  
  433. begin_statement
  434.     : BEGIN_TOKEN 
  435.         { 
  436. #ifdef OPTIMIZE_SPECIALIZERS
  437.             symtab_push_begin ();
  438. #endif
  439.         }
  440.       body END
  441.         {
  442. #ifdef OPTIMIZE_SPECIALIZERS
  443.             symtab_pop ();
  444. #endif
  445.             $$ = $3;
  446.         }
  447.  
  448.  
  449. if_statement
  450.     : IF        { push_intermediate_words ($1); }
  451.         '(' expression ')' then_body
  452.         else_parts
  453.             { pop_intermediate_words (); }
  454.         END IF_opt
  455.             { $$ = cons ($1,
  456.                      cons ($4,
  457.                        append_bang (cons ($6,
  458.                                   make_empty_list()),
  459.                             $7))); }
  460.  
  461. then_body
  462.     :        { $$ = false_object; }
  463.     | nonempty_body    { $$ = $1; }
  464.  
  465. else_parts
  466.     :        { $$ = cons(false_object, make_empty_list()); }
  467.     | ELSE        { $$ = cons (false_object, make_empty_list()); }
  468.     | ELSE nonempty_body    { $$ = cons ($2, make_empty_list()); }
  469.     | ELSEIF '(' expression ')' body else_parts
  470.             { $$ = cons (cons (if_symbol,
  471.                        cons ($3,
  472.                          append_bang (cons ($5,
  473.                                     make_empty_list()),
  474.                                   $6))),
  475.                      make_empty_list()); }
  476.  
  477.  
  478. unless_statement
  479.     : UNLESS '(' expression ')' body END UNLESS_opt
  480.         { $$ = cons ($1, cons ($3, cons ($5, make_empty_list()))); }
  481.  
  482.  
  483. case_statement
  484.     : CASE case_body
  485.         END CASE_opt
  486.         { $$ = cons (cond_symbol, $2); }
  487.  
  488. case_body
  489.     : { $$ = make_empty_list(); } 
  490.     | case_label 
  491.       { push_bindings (); }
  492.       case_tail SEMICOLON_opt
  493.       { $$ =  cons (cons ($1, !EMPTYLISTP (CAR ($3))
  494.                   ? cons (cons (unbinding_begin_symbol,
  495.                             cons (bindings_top (),
  496.                               CAR ($3))),
  497.                           make_empty_list())
  498.                   : make_empty_list()),
  499.                 CDR ($3));
  500.           }
  501.  
  502.  
  503. case_tail
  504.     :    { $$ = cons (make_empty_list(), make_empty_list()); }
  505.     | ';'    { $$ = cons (make_empty_list(), make_empty_list()); }
  506.     | ';' case_label
  507.     { push_bindings (); }
  508.     case_tail
  509.     { $$ = cons (make_empty_list(),
  510.              cons (cons ($2, !EMPTYLISTP (CAR ($4))
  511.                      ? cons (cons (unbinding_begin_symbol,
  512.                                cons (bindings_top(),
  513.                              CAR ($4))),
  514.                              make_empty_list())
  515.                      : make_empty_list()),
  516.                   CDR ($4)));
  517.       pop_bindings ();
  518.       }
  519.  
  520.     | constituent
  521.       { $$ = cons (cons ($1, make_empty_list()), make_empty_list()); }
  522.  
  523.     | constituent ';' case_tail
  524.         {
  525.          $$ = cons (cons ($1, FIRST ($3)), CDR ($3));
  526.         }
  527.     | constituent ';' case_label { push_bindings(); }
  528.        case_tail
  529.     { $$ = cons (cons ($1, make_empty_list()), 
  530.              cons ( cons($3, !EMPTYLISTP (CAR ($5))
  531.                      ? cons (cons (unbinding_begin_symbol,
  532.                            cons (bindings_top(),
  533.                                  CAR ($5))),
  534.                          make_empty_list())
  535.                      : make_empty_list()),
  536.                CDR ($5)));
  537.           pop_bindings ();
  538.           }
  539. /*
  540.     | local_declaration_block ';' case_label case_tail
  541. */
  542.  
  543. case_label
  544.     : expression EQUAL_ARROW
  545.         { $$ = $1; }
  546.     | OTHERWISE EQUAL_ARROW_opt
  547.         { $$ = else_keyword; }
  548.  
  549. select_statement
  550.     : SELECT    { push_intermediate_words ($1); }
  551.         '(' expression test_opt 
  552.             { pop_intermediate_words (); }
  553.         ')' select_body
  554.         END SELECT_opt
  555.         { $$ = cons ($1, cons ($4, cons ($5 ? $5 : equal_equal_symbol,
  556.                          $8))); }
  557.  
  558. test_opt
  559.     :             { $$ = NULL; }
  560.     | BY expression        { $$ = $2; }
  561. select_body
  562.     :  { $$ = make_empty_list(); }
  563.     | select_label 
  564.       { push_bindings (); }
  565.       select_tail SEMICOLON_opt
  566.       { $$ =  cons (cons ($1, !EMPTYLISTP (CAR ($3))
  567.                   ? cons (cons (unbinding_begin_symbol,
  568.                         cons (bindings_top (),
  569.                               CAR ($3))),
  570.                           make_empty_list())
  571.                   : make_empty_list()),
  572.               CDR ($3));
  573.           }
  574.  
  575. select_tail
  576.     :    { $$ = cons (make_empty_list(), make_empty_list()); }
  577.     | ';'    { $$ = cons (make_empty_list(), make_empty_list()); }
  578.     | ';' select_label
  579.     { push_bindings (); }
  580.     select_tail
  581.     { $$ = cons (make_empty_list(),
  582.              cons (cons ($2, !EMPTYLISTP (CAR ($4))
  583.                      ? cons (cons (unbinding_begin_symbol,
  584.                                cons (bindings_top(),
  585.                              CAR ($4))),
  586.                              make_empty_list())
  587.                      : make_empty_list()),
  588.                    CDR ($4)));
  589.       pop_bindings ();
  590.       }
  591.  
  592.     | constituent
  593.       { $$ = cons (cons ($1, make_empty_list()), make_empty_list()); }
  594.  
  595.     | constituent ';' select_tail
  596.         {
  597.          $$ = cons (cons ($1, FIRST ($3)), CDR ($3));
  598.         }
  599.     | constituent ';' select_label { push_bindings(); }
  600.        select_tail
  601.     { $$ = cons (cons ($1, make_empty_list()), 
  602.              cons ( cons($3, !EMPTYLISTP (CAR ($5))
  603.                      ? cons (cons (unbinding_begin_symbol,
  604.                            cons (bindings_top(),
  605.                                  CAR ($5))),
  606.                          make_empty_list())
  607.                      : make_empty_list()),
  608.                CDR ($5)));
  609.           pop_bindings ();
  610.           }
  611. /*
  612.     | local_declaration_block ';' select_label select_tail
  613. */
  614.  
  615. select_label
  616.     : expressions EQUAL_ARROW
  617.         { $$ = $1; }
  618.     | '(' expression ',' expressions ')' EQUAL_ARROW
  619.         {  $$ = cons ($2, $4); }
  620.     | OTHERWISE EQUAL_ARROW_opt
  621.         { $$ = else_keyword; }
  622.  
  623. while_statement
  624.     : WHILE '(' expression ')' body END WHILE_opt
  625.         { $$ = cons ($1, cons ($3, cons ($5, make_empty_list()))); }
  626.  
  627. until_statement
  628.     : UNTIL '(' expression ')' body END UNTIL_opt
  629.         { $$ = cons ($1, cons ($3, cons ($5, make_empty_list()))); }
  630.  
  631. for_statement
  632.     : FOR        { push_intermediate_words ($1); }
  633.  
  634.         '(' for_clauses_opt for_terminator_opt
  635.             { pop_intermediate_words (); }
  636.         ')' body
  637.          finally_opt END { pop_intermediate_words (); } FOR_opt
  638.         { $$ = listem (for_symbol,    
  639.                    $4,
  640.                    append_bang($5, $9),
  641.                    $8,
  642.                    NULL);
  643.         }
  644. for_clauses
  645.     : for_clause comma_opt        { $$ = cons ($1, make_empty_list()); }
  646.     | for_clause ',' for_clauses    { $$ = cons ($1, $3); }
  647.  
  648. for_clauses_opt
  649.     :             { $$ = make_empty_list(); }
  650.     | for_clauses        { $$ = $1; }
  651.     
  652. for_clause
  653.     : variable '=' expression THEN expression
  654.         { $$ = cons ($1, cons ($3, cons ($5, make_empty_list()))); }
  655.     | variable IN expression
  656.         { $$ = cons (collection_keyword,
  657.              cons ($1, cons ($3, make_empty_list()))); }
  658.     | variable FROM expression bound_opt increment_clause_opt
  659.         { $$ = cons (range_keyword,
  660.                  cons ($1,
  661.                    cons ($3,
  662.                      append_bang($4, $5)))); }
  663.  
  664. bound_opt
  665.     :    { $$ = make_empty_list(); }
  666.         | TO expression
  667.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  668.     | ABOVE expression
  669.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  670.     | BELOW expression
  671.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  672.  
  673. increment_clause_opt
  674.     :    { $$ = make_empty_list(); }
  675.     | BY expression
  676.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  677.  
  678. for_terminator_opt
  679.     :            { $$ = cons (false_object,
  680.                          make_empty_list()); }
  681.     | UNTIL expression    { $$ = cons ($2, make_empty_list()); }
  682.     | WHILE expression    { $$ = cons (cons (not_symbol,
  683.                                cons ($2,
  684.                                                          make_empty_list())),
  685.                                              make_empty_list()); }
  686.     | KEYWORD expression    { if ($1 == until_keyword) {
  687.                       $$ =cons ($2, make_empty_list());
  688.                   } else if ($1 == while_keyword) {
  689.                       $$ = cons (cons (not_symbol,
  690.                                cons ($2,
  691.                                  make_empty_list())),
  692.                              make_empty_list());
  693.                   } else {
  694.                     error ("Bogus keyword in if",
  695.                         $1,
  696.                         NULL);
  697.                   }
  698.                 }
  699.  
  700. finally_opt
  701.     :            { $$ = make_empty_list(); }
  702.     | FINALLY body        { $$ = cons ($2, make_empty_list()); }
  703.  
  704. block_statement
  705.     : BLOCK        { push_intermediate_words ($1); }
  706.         '(' variable_name ')' body cleanups
  707.             { pop_intermediate_words (); }
  708.         END BLOCK_opt
  709.  
  710. cleanups
  711.     :                { $$ = make_empty_list(); }
  712.     | cleanup            { $$ = cons ($1, make_empty_list()); }
  713.     | cleanup ';' cleanups        { $$ = cons ($1, $3); }
  714.  
  715. cleanup
  716.     : CLEANUP body    { $$ = cons ($1, cons ($2, make_empty_list())); }
  717.     | EXCEPTION '(' exception_args ')' body
  718.         { $$ = cons ($1, cons ($3, cons ($5, make_empty_list()))); }
  719.  
  720. exception_args
  721.     : variable_name        { $$ = cons ($1, make_empty_list()); }
  722.     | variable_name COLON_COLON variable_name comma_arguments_opt
  723.         { $$ = cons (cons ($1, cons ($3, make_empty_list())), $4); }
  724.  
  725. IF_opt
  726.     :
  727.     | IF
  728.  
  729. UNLESS_opt
  730.     :
  731.     | UNLESS
  732.  
  733. CASE_opt
  734.     :
  735.     | CASE
  736.  
  737. SELECT_opt
  738.     :
  739.     | SELECT
  740.  
  741. WHILE_opt
  742.     :
  743.     | WHILE
  744.  
  745. UNTIL_opt
  746.     :
  747.     | UNTIL
  748.  
  749. FOR_opt
  750.     :
  751.     | FOR
  752.  
  753. BLOCK_opt
  754.     :
  755.     | BLOCK
  756.     
  757. defining_form
  758.     : DEFINE modifiers_opt METHOD method_definition
  759.         /* worry about modifiers later. */
  760.         { $$ = cons (define_method_symbol, $4); }
  761.  
  762.     | DEFINE modifiers_opt GENERIC generic_function_definition
  763.         /* worry about modifiers later. */
  764.         { $$ = cons (define_generic_function_symbol, $4); }
  765.  
  766. /*    | DEFINE modifiers_opt defining_word definition */
  767.  
  768.     | DEFINE VARIABLE bindings
  769.         { $$ = cons (define_variable_symbol, CAR ($3)); }
  770.  
  771.     | DEFINE CONSTANT bindings
  772.         { $$ = cons (define_constant_symbol, CAR ($3)); }
  773.  
  774.     | DEFINE modifiers_opt CLASS
  775.         { push_intermediate_words ($3); }
  776.       class_definition
  777.         { pop_intermediate_words ();
  778.           if (EMPTYLISTP ($2)) {
  779.             $$ = cons (define_class_symbol, $5); 
  780.           } else {
  781.             $$ = cons (define_class_symbol,
  782.                    cons (cons (modifiers_keyword,
  783.                            $2),
  784.                      $5));
  785.           }
  786.         }
  787. /*
  788.     | DEFINE modifiers_opt defining_word bindings
  789. */
  790.  
  791.     | DEFINE MODULE
  792.         { push_intermediate_words ($2); }
  793.       module_definition
  794.         { $$ = cons (define_module_symbol, $4); }
  795.  
  796.     | DEFINE TEST SYMBOL '(' arguments_opt ')'
  797.       body END TEST_opt variable_name_opt
  798.         { $$ = listem (define_test_symbol, $3, $5,
  799.                    empty_string, $7, NULL); }
  800.  
  801. class_definition
  802.     : variable_name expression_list slot_specs END CLASS_opt
  803.          variable_name_opt
  804.         { $$ = cons ($1, cons ($2, $3)); }
  805.  
  806. slot_specs
  807.     :                { $$ = make_empty_list(); }
  808.     | slot_spec            { $$ = cons ($1, make_empty_list()); }
  809.     | slot_spec ';' slot_specs    { $$ = cons ($1, $3); }
  810.  
  811. slot_spec
  812.     :
  813.       initialization_argument_spec { $$ = $1; }
  814.     |
  815.       slot_modifiers_opt SLOT variable comma_arguments_opt
  816.         { Object mods, mod;
  817.           Object allocation, getter_name, slot_type, dynamism;
  818.           int dynamism_specified = 0, allocation_specified = 0;
  819.           int slot_type_specified = 0;
  820.  
  821.           slot_type = cons (type_keyword,
  822.                     cons (CLASSNAME (object_class),
  823.                       make_empty_list()));
  824.           allocation = cons (allocation_keyword,
  825.                      cons (instance_symbol,
  826.                        make_empty_list()));
  827.           dynamism = cons (dynamism_keyword,
  828.                    cons (open_symbol,
  829.                      make_empty_list()));
  830.           if (PAIRP ($3)) {
  831.               getter_name = CAR ($3);
  832.               slot_type_specified = 1;
  833.               SECOND (slot_type) = SECOND ($3);
  834.           } else {
  835.               getter_name = $3;
  836.           }
  837.           mods = $1;
  838.           while ( PAIRP (mods)) {
  839.               mod = CAR (mods);
  840.               if (id (mod, open_symbol)) {
  841.               if (dynamism_specified) {
  842.                   error ("Slot dyanamism specified twice", NULL);
  843.               }
  844.               dynamism_specified = 1;
  845.               } else if (id (mod, sealed_symbol)) {
  846.               if (dynamism_specified) {
  847.                   error ("Slot dyanamism specified twice", NULL);
  848.               }
  849.               SECOND (dynamism) = sealed_symbol;
  850.               } else if (allocation_word (mod)) {
  851.               if (allocation_specified) {
  852.                   error ("Slot allocation specified twice", NULL);
  853.               }
  854.               allocation_specified = 1;
  855.               SECOND (allocation) = mod;
  856.               if ( ! EMPTYLISTP (CDR (mods))) {
  857.                   error ("Slot modifiers follow allocation",
  858.                      mods, NULL);
  859.               }
  860.               }
  861.               mods = CDR (mods);
  862.           }
  863.           $$ = cons (getter_name, $4);
  864.           if (slot_type_specified) {
  865.               append_bang ($$, slot_type);
  866.           }
  867.           if (allocation_specified) {
  868.               append_bang ($$, allocation);
  869.           }
  870.           if (dynamism_specified) {
  871.               append_bang ($$, dynamism);
  872.           }
  873.         }
  874.  
  875. slot_modifiers_opt
  876.     :                 { $$ = make_empty_list(); }
  877.     | SYMBOL slot_modifiers_opt     { $$ = cons ($1, $2); }
  878.     | CLASS slot_modifiers_opt    { $$ = cons ($1, $2); }
  879.  
  880. initialization_argument_spec
  881.     : SYMBOL KEYWORD comma_arguments_opt
  882.         {
  883.           if ($1 != keyword_symbol) {
  884.             error ("Bad initialization argument specification", NULL);
  885.           } else {
  886.             $$ = cons (init_keyword_keyword, cons ($2, $3));
  887.           }
  888.         }
  889.     | SYMBOL SYMBOL KEYWORD comma_arguments_opt
  890.         {
  891.           if ($1 != required_symbol || $2 != keyword_symbol) {
  892.             error ("Bad initialization argument specification", NULL);
  893.           } else {
  894.             $$ = cons (required_init_keyword_keyword,
  895.                 cons ($3, $4));
  896.           }
  897.         }
  898.  
  899. method_definition
  900.     : variable_name method_body END METHOD_opt variable_name_opt
  901.         { $$ = cons ($1, $2); }
  902.  
  903. generic_function_definition
  904.     : variable_name generic_function_body
  905.         { $$ = cons ($1, $2); }
  906. /*
  907. definition
  908.     : variable_name expression_list_opt item_list_opt END defining_word_opt variable_name_opt
  909. */
  910.  
  911. module_definition
  912.     : variable_name module_clauses END MODULE_opt variable_name_opt
  913.         { $$ = cons ($1, $2); }
  914.  
  915. module_clauses
  916.     :    { $$ = make_empty_list(); }
  917.     | module_clause ';' module_clauses
  918.         { $$ = cons ($1, $3); }
  919.  
  920. module_clause
  921.     : use_clause        { $$ = $1; }
  922.     | export_clause        { $$ = $1; }
  923.     | create_clause        { $$ = $1; }
  924.  
  925. use_clause
  926.     : USE variable_name property_list_opt
  927.         { $$ = cons ($1, cons ($2, $3)); }
  928.  
  929. export_clause
  930.     : EXPORT item_names    { $$ = cons ($1, $2); }
  931. create_clause
  932.     : CREATE item_names    { $$ = cons ($1, $2); }
  933.  
  934. modifiers
  935.     : SYMBOL        { $$ = cons ($1, make_empty_list()); }
  936.     | SYMBOL modifiers     { $$ = cons ($1, $2); }
  937.  
  938. expression_list
  939.     : '(' expressions_opt ')'    { $$ = $2; }
  940.  
  941. expressions
  942.     : expression            { $$ = cons ($1, make_empty_list()); }
  943.     | expression ',' expressions    { $$ = cons ( $1, $3); }
  944.  
  945. /*
  946. item_list
  947.     : items SEMICOLON_opt
  948.  
  949. items    : item
  950.     | items ';' item
  951.  
  952. item    : item_modifiers_and_word item_names property_list_opt
  953.     | item_modifiers_and_word item_names type_designator property_list_opt
  954.  
  955. item_modifiers_and_word
  956.     : variable_name
  957.     | item_modifiers_and_word variable_name
  958.  
  959. */
  960.  
  961. item_names
  962.     : variable_name            { $$ = cons ($1, make_empty_list()); }
  963.     | variable_name ',' item_names    { $$ = cons ($1, $3); }
  964.  
  965.  
  966. /* Methods and Generic Functions */
  967.  
  968. method_body
  969.     : '(' parameter_list_opt ')' 
  970.         {   
  971. #ifdef OPTIMIZE_SPECIALIZERS
  972.             symtab_push_parameters ($2);
  973. #endif
  974.         }
  975.       SEMICOLON_opt body
  976.         {   
  977. #ifdef OPTIMIZE_SPECIALIZERS
  978.             symtab_pop ();
  979. #endif
  980.             $$ = cons ($2, cons ($6, make_empty_list()));
  981.         }
  982.     | '(' parameter_list_opt ')' EQUAL_ARROW variable ';' body
  983.         { $$ = cons (append_bang ($2,
  984.                       cons (hash_values_symbol,
  985.                         cons ($5, make_empty_list()))),
  986.                  cons ($7, make_empty_list())); }
  987.  
  988.     | '(' parameter_list_opt ')' EQUAL_ARROW '(' value_list_opt ')' SEMICOLON_opt body
  989.         { $$ = cons (append_bang ($2,
  990.                       cons (hash_values_symbol, $6)),
  991.                  cons ( $9, make_empty_list())); }
  992. generic_function_body
  993.     : '(' parameter_list_opt ')'
  994.         { $$ = cons ($2, make_empty_list()); }
  995.     | '(' parameter_list_opt ')' EQUAL_ARROW variable
  996.         { $$ = cons (append_bang ($2, cons (hash_values_symbol,
  997.                           cons ($5, make_empty_list()))),
  998.                  make_empty_list()); }
  999.     | '(' parameter_list_opt ')' EQUAL_ARROW '(' value_list_opt ')'
  1000.         { $$ = cons (append_bang ($2, cons (hash_values_symbol, $6)),
  1001.                   make_empty_list()); }
  1002.  
  1003. parameter_list
  1004.     : parameter        { $$ = cons ($1, make_empty_list()); }
  1005.     | parameter_list ',' parameter
  1006.         { $$ = append_bang ($1, cons ($3, make_empty_list())); }
  1007.     | parameter_list ',' next_rest_key_parameter_list
  1008.             { $$ = append_bang ($1, $3); }
  1009.     | next_rest_key_parameter_list
  1010.             { $$ = $1; }
  1011.  
  1012. next_rest_key_parameter_list
  1013.     : HASH_NEXT variable_name
  1014.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  1015.     | HASH_NEXT variable_name ',' rest_key_parameter_list
  1016.         { $$ = cons ($1, cons ($2, $4)); }
  1017.     | rest_key_parameter_list
  1018.         { $$ = $1; }
  1019.  
  1020. rest_key_parameter_list
  1021.     : HASH_REST variable_name
  1022.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  1023.     | HASH_REST variable_name ',' key_parameter_list
  1024.         { $$ = cons ($1, cons ($2, $4)); }
  1025.     | key_parameter_list
  1026.         { $$ = $1; }
  1027.  
  1028. key_parameter_list
  1029.     : HASH_KEY    { $$ = cons ($1, make_empty_list()); }
  1030.     | HASH_KEY ',' HASH_ALL_KEYS
  1031.             { $$ = cons ($1, cons ($3, make_empty_list())); }
  1032.     | HASH_KEY keyword_parameters
  1033.             { $$ = cons ($1, $2); }
  1034.     | HASH_ALL_KEYS
  1035.         { $$ = cons ($1, make_empty_list()); }
  1036.  
  1037. parameter
  1038.     : variable_name type_designator_opt
  1039.         { $$ = ($2 ? cons ($1, cons ($2, make_empty_list()))
  1040.             : $1);
  1041.         }
  1042.     | variable_name EQUAL_EQUAL expression
  1043.         { $$ = cons ($1, cons (cons (singleton_symbol,
  1044.                          cons ($3, make_empty_list())),
  1045.                        make_empty_list())); }
  1046.  
  1047. keyword_parameters
  1048.     : keyword_parameter    { $$ = cons ($1, make_empty_list()); }
  1049.     | HASH_ALL_KEYS        { $$ = cons ($1, make_empty_list()); }
  1050.     | keyword_parameter ',' keyword_parameters
  1051.             { $$ = cons ($1, $3); }
  1052.  
  1053.  
  1054. keyword_parameter
  1055.     : KEYWORD variable_name_opt default_opt
  1056.         { if ($3) {
  1057.             if ($2) {
  1058.             $$ =cons ($1, cons ($2, cons($3, make_empty_list())));
  1059.             } else {
  1060.             $$ = cons ($1, cons ($3, make_empty_list ()));
  1061.             }
  1062.           } else {
  1063.               $$ = cons ($1, cons ($2, make_empty_list()));
  1064.           }
  1065.         }
  1066.  
  1067.     | variable_name default_opt
  1068.         {  if ($2) {
  1069.             $$ = cons ($1, cons ($2, make_empty_list()));    
  1070.         } else {
  1071.             $$ = $1;
  1072.         }
  1073.            }
  1074.  
  1075. default    :  '=' expression        { $$ = $2; }
  1076.  
  1077. /* Old style */
  1078. /*
  1079.     '(' expression ')'        { $$ = $2; }
  1080.  */
  1081.  
  1082. /* Local Declarations */
  1083.  
  1084. /*
  1085. local_declaration_block
  1086.     : local_declaration ';' body
  1087.         { $$ = cons (bind_symbol,
  1088.                  cons ($1, cons ($3, make_empty_list()))); }
  1089. */
  1090.  
  1091. local_declaration
  1092.     : LET bindings
  1093. /*
  1094.         { $$ = $2; }
  1095. */
  1096.  
  1097.         {   bindings_increment ();
  1098. #ifdef OPTIMIZE_SPECIALIZERS
  1099.             symtab_insert_bindings ($2);
  1100. #endif
  1101.             $$ = cons (local_bind_symbol,
  1102.                    cons ($2, make_empty_list()));
  1103.         }
  1104.     | LET HANDLER condition '=' handler
  1105.     | LOCAL { methnames = methdefs = make_empty_list(); }
  1106.       local_methods
  1107.  
  1108.           {   Object methbindings = cons (append (methnames,
  1109.                           cons (cons (values_symbol,
  1110.                                   methdefs),
  1111.                             make_empty_list())),
  1112.                       make_empty_list()); 
  1113. #ifdef OPTIMIZE_SPECIALIZERS
  1114.           symtab_insert_bindings (methbindings);
  1115. #endif
  1116.           bindings_increment ();
  1117.           $$ = cons (local_bind_symbol,
  1118.              cons ( methbindings,
  1119.                    make_empty_list()));
  1120.       }
  1121.  
  1122.  
  1123. condition
  1124.     : unparenthesized_operand        { $$ = $1; }
  1125.     | '(' type property_list_opt ')'
  1126.  
  1127. handler    : expression                { $$ = $1; }
  1128.  
  1129. local_methods
  1130.     : METHOD_opt method_definition
  1131.         {
  1132.          methnames = cons (FIRST ($2), methnames);
  1133.          methdefs = cons (cons (method_symbol, CDR ($2)), methdefs);
  1134.         }
  1135.     | METHOD_opt method_definition ',' 
  1136.         {
  1137.          methnames = cons (FIRST ($2), methnames); 
  1138.          methdefs = cons (cons (method_symbol, CDR ($2)), methdefs);
  1139.         }
  1140.       local_methods
  1141.  
  1142. bindings
  1143.     : variable '=' expression
  1144.         { $$ = cons (cons ($1, cons ($3, make_empty_list())),
  1145.                  make_empty_list()); }
  1146.     | '(' variable_list ')' '=' expression
  1147.           { $$ = cons (append_bang ($2, cons ($5, make_empty_list())),
  1148.                  make_empty_list()); }
  1149.  
  1150. variable_list
  1151.     : variable        { $$ = cons ($1, make_empty_list()); }
  1152.     | variable ',' variable_list
  1153.                 { $$ = cons ($1, $3); }
  1154.     | HASH_REST variable_name 
  1155.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  1156.  
  1157.  
  1158. value_variable_list
  1159.     : variable        { $$ = cons ($1, make_empty_list()); }
  1160.     | variable ',' value_variable_list
  1161.                 { $$ = cons ($1, $3); }
  1162.     | HASH_REST variable
  1163.         { $$ = cons ($1, cons ($2, make_empty_list())); }
  1164.  
  1165. variable
  1166.     : variable_name type_designator_opt
  1167.         { $$ = ($2 ? cons ($1, cons ($2, make_empty_list()))
  1168.             : $1); }
  1169.  
  1170. variable_name
  1171.     : SYMBOL        { $$ = $1; }
  1172.     | defining_word        { $$ = $1; }
  1173.  
  1174. variable_name_opt
  1175.     :            { $$ = NULL; }
  1176.     | variable_name        { $$ = $1; }
  1177.  
  1178. type_designator
  1179.     : COLON_COLON type    { $$ = $2; }
  1180.  
  1181. type    : operand        { $$ = $1; }
  1182.  
  1183.  
  1184. /* Property Lists */
  1185.  
  1186. property_list
  1187.     : property            { $$ = cons ($1, make_empty_list()); }
  1188.     | property  property_list    { $$ = cons ($1, $2); }
  1189.  
  1190. property
  1191.     : ',' KEYWORD value
  1192.         { $$ = cons ($2, $3); }
  1193.  
  1194. value    : expression            { $$ = $1; }
  1195.     | '{' property_set_opt '}'    { $$ = $2; }
  1196.  
  1197. property_set
  1198.     : property_set_member        { $$ = cons ($1, make_empty_list()); }
  1199.     | property_set_member ',' property_set        { $$ = cons ($1, $3); }
  1200.  
  1201. property_set_member
  1202.     : property_set_item        { $$ = $1; }
  1203.     | property_set_item EQUAL_ARROW property_set_item
  1204.         { $$ = cons ($1, $3); }
  1205.  
  1206. property_set_item
  1207.     : variable_name            { $$ = $1; }
  1208.  
  1209.  
  1210. /* Optional Items */
  1211.  
  1212. EQUAL_ARROW_opt
  1213.     :        { $$ = NULL; }
  1214.     | EQUAL_ARROW    { $$ = $1; }
  1215.  
  1216. METHOD_opt
  1217.     :
  1218.     | METHOD
  1219.  
  1220. CLASS_opt
  1221.     :
  1222.     | CLASS
  1223.  
  1224. TEST_opt
  1225.     :
  1226.     | TEST
  1227.  
  1228. MODULE_opt
  1229.     :
  1230.     | MODULE
  1231.  
  1232. SEMICOLON_opt
  1233.     :
  1234.     | ';'
  1235.  
  1236. comma_opt
  1237.     :
  1238.     | ','
  1239.  
  1240. comma_arguments_opt
  1241.     :         { $$ = make_empty_list(); }
  1242.     | ',' arguments { $$ = $2; }
  1243.  
  1244. arguments_opt
  1245.     :        { $$ = make_empty_list(); }
  1246.     | arguments    { $$ = $1; }
  1247.  
  1248. constants_opt
  1249.     :        { $$ = make_empty_list(); }
  1250.     | constants    { $$ = $1; }
  1251.  
  1252. list_constants_opt
  1253.     :                 { $$ = cons (list_symbol,
  1254.                              make_empty_list()); }
  1255.     | list_constants        { $$ = $1; }
  1256.  
  1257. default_opt
  1258.     :        { $$ = NULL; }
  1259.     | default    { $$ = $1; }
  1260.  
  1261. /*
  1262. defining_word_opt
  1263.     :
  1264.     | defining_word
  1265.  
  1266. expression_list_opt
  1267.     :
  1268.     | expression_list
  1269. */
  1270.  
  1271. expressions_opt
  1272.     :            { $$ = make_empty_list(); }
  1273.     | expressions        { $$ = $1; }
  1274.  
  1275. /*
  1276. item_list_opt
  1277.     :
  1278.     | item_list
  1279. */
  1280.  
  1281. modifiers_opt
  1282.     :            { $$ = make_empty_list(); }
  1283.     | modifiers        { $$ = $1; }
  1284.  
  1285. parameter_list_opt
  1286.     :            { $$ = make_empty_list(); }
  1287.     | parameter_list    { $$ = $1; }
  1288.  
  1289. property_list_opt
  1290.     :            { $$ = make_empty_list(); }
  1291.     | property_list        { $$ = $1; }
  1292.  
  1293. property_set_opt
  1294.     :            { $$ = make_empty_list(); }
  1295.     | property_set        { $$ = $1; }
  1296.  
  1297. type_designator_opt
  1298.     :            { $$ = NULL; }
  1299.     | type_designator    { $$ = $1; }
  1300.  
  1301. value_list_opt
  1302.     :            { $$ = make_empty_list(); }
  1303.     | value_variable_list        { $$ = $1; }
  1304.  
  1305. %%
  1306.  
  1307. void yyerror(char *s)
  1308. {
  1309.     char line_str[20];
  1310.     sprintf (line_str, " [line #%d]", yylineno);
  1311.     warning (s,
  1312.          make_byte_string (yytext),
  1313.          make_byte_string (line_str),
  1314.          NULL);
  1315. }
  1316.  
  1317. /*
  1318.  * append_bang appends l2 to l1 if l1 is nonempty.
  1319.  * if l1 is empty, it just returns l2.
  1320.  */    
  1321. static Object
  1322. append_bang(Object l1, Object l2)
  1323. {
  1324.     Object res = l1;
  1325.  
  1326.     if (EMPTYLISTP (l1)) {
  1327.         return l2;
  1328. #if 0
  1329.     fprintf(stderr, "Whoa! append! to empty_list!\n");
  1330.     abort();
  1331. #endif
  1332.     }
  1333.     while (PAIRP (CDR (l1))) {
  1334.     l1 = CDR (l1);
  1335.     }
  1336.     CDR (l1) = l2;
  1337.     return res;
  1338. }
  1339.  
  1340. static void
  1341. push_bindings()
  1342. {
  1343.     binding_stack = cons (make_integer(0), binding_stack);
  1344. }
  1345.  
  1346. static void
  1347. pop_bindings()
  1348. {
  1349.     binding_stack = CDR (binding_stack);
  1350. }
  1351.  
  1352.  
  1353. static Object
  1354. bindings_top ()
  1355. {
  1356.     return CAR (binding_stack);
  1357. }
  1358.  
  1359. static Object
  1360. bindings_increment ()
  1361. {
  1362.     CAR (binding_stack) = make_integer (INTVAL (CAR (binding_stack)) + 1);
  1363. }
  1364.  
  1365. static Object
  1366. make_setter_expr (Object place, Object value)
  1367. {
  1368.     Object newsym;
  1369.  
  1370.     if ( ! PAIRP (place)) {
  1371.     error("Trying to make a setter from something that's not a place",
  1372.           place, NULL);
  1373.     }
  1374.     newsym = gensym(1);
  1375.     return listem (unbinding_begin_symbol,
  1376.            make_integer (1),
  1377.            cons (local_bind_symbol,
  1378.              cons(cons(cons(newsym,
  1379.                     cons (value,
  1380.                           make_empty_list())),
  1381.                    make_empty_list()),
  1382.                   make_empty_list())),
  1383.            cons (make_setter_symbol (FIRST (place)),
  1384.              cons (newsym, CDR (place))),
  1385.            newsym,
  1386.            NULL);
  1387. }
  1388.  
  1389. #define    GENSYM_BUFSIZE    128
  1390. char gensymbuf[GENSYM_BUFSIZE];
  1391.  
  1392. static Object
  1393. gensym(int i)
  1394. {
  1395.     sprintf( gensymbuf, "\"tmp%d", i);
  1396.     return make_symbol (gensymbuf);
  1397. }
  1398.  
  1399. int
  1400. allocation_word (Object word)
  1401. {
  1402.     return (id (word, instance_symbol) || id (word, class_symbol)
  1403.         || id (word, each_subclass_symbol) || id (word, constant_symbol)
  1404.         || id (word, virtual_symbol) || id (word, inherited_symbol));
  1405. }
  1406.  
  1407. #ifdef OPTIMIZE_SPECIALIZERS
  1408. static void
  1409. symtab_push_begin ()
  1410. {
  1411.     symtab = cons (make_table (DEFAULT_TABLE_SIZE), symtab);
  1412. }
  1413.  
  1414. static void
  1415. symtab_insert_bindings (Object bindings)
  1416. {
  1417.     Object variable;
  1418.  
  1419. #if 0
  1420.     warning ("Got symtab_insert_bindings", bindings, NULL);
  1421. #endif
  1422.  
  1423.     /*
  1424.      * bindings created by parser are always of form
  1425.      *  #( #( variable1, variable2, ... , variablen, values))
  1426.      */
  1427.     bindings = CAR (bindings);
  1428.     while ( !EMPTYLISTP (CDR (bindings))) {
  1429.     variable = CAR (bindings);
  1430.     if (PAIRP (variable)) {
  1431. #if 0
  1432.         warning ("  symtab element",
  1433.              CAR (variable),
  1434.              SECOND (variable),
  1435.              NULL);
  1436. #endif
  1437.         table_element_setter (CAR (symtab),
  1438.                   CAR (variable),
  1439.                   SECOND (variable));
  1440.     }
  1441.     bindings = CDR (bindings);
  1442.     }
  1443. }
  1444.  
  1445. static void
  1446. symtab_push_parameters (Object parameters)
  1447. {
  1448.     Object variable;
  1449.  
  1450.     symtab = cons (make_table (DEFAULT_TABLE_SIZE), symtab);
  1451. #if 0
  1452.     warning ("Got symtab_insert_parameters", parameters, NULL);
  1453. #endif
  1454.  
  1455.     while (PAIRP (parameters)) {
  1456.     variable = CAR (parameters);
  1457.     if (! PAIRP (variable) && ! SYMBOLP (variable) ) {
  1458.         /* we got to a keyword parameter or a hash-word */
  1459.         break;
  1460.     }
  1461.     if (PAIRP (variable)) {
  1462. #if 0
  1463.    warning ("  symtab element",
  1464.              CAR (variable),
  1465.              SECOND (variable),
  1466.              NULL);
  1467. #endif
  1468.         table_element_setter (CAR (symtab),
  1469.                   CAR (variable),
  1470.                   SECOND (variable));
  1471.     }
  1472.     parameters = CDR (parameters);
  1473.     }
  1474. }
  1475.  
  1476. static void
  1477. symtab_pop ()
  1478. {
  1479.     symtab = CDR (symtab);
  1480. }
  1481. #endif
  1482.